home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stTrStr.c < prev    next >
C/C++ Source or Header  |  1995-10-17  |  7KB  |  240 lines

  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stTrStr.c    1.2    95/10/17")
  13.  
  14.  
  15.  
  16. /*
  17.  *  (Object) Type conversion routines do not follow the
  18.  *  standard Tcl argument convention because name1+name2
  19.  *  are processed by the common trace routine above.
  20.  */
  21.  
  22. /* I/O Char Trace */
  23. char *
  24. Struct_TraceChar(cdata, interp,name1,name2,flags)
  25.   ClientData cdata;
  26.   Tcl_Interp *interp;
  27.   char *name1,*name2;
  28.   int flags;
  29. {
  30.     Struct_Object *object = (Struct_Object *)cdata;
  31.  
  32.     if (flags & TCL_TRACE_READS) {
  33.     if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
  34.         /* Read an array of chars */
  35.         char *charbuf;
  36.         if ((charbuf = ckalloc( object->size + 1 )) == NULL)
  37.             return "can't allocate memory for char result";
  38.         memcpy( charbuf, object->data, object->size );
  39.         charbuf[object->size] = '\0';
  40.         if (object->type->fill != NULL && *object->type->fill) {
  41.         /* Remove trailing fill characters */
  42.         char *s;
  43.         int ch = *object->type->fill;
  44.         if ( (*charbuf == '\0') &&
  45.              !(object->type->flags & STRUCT_FLAG_NULL_OK) )
  46.             return "nul character";
  47.         for ( s = charbuf + object->size;
  48.               (--s > charbuf) && (*s == ch); )
  49.             *s = '\0';
  50.             if ( (--s == charbuf) &&
  51.              !(object->type->flags & STRUCT_FLAG_NULL_OK) )
  52.             *s = '\0';
  53.         }
  54.         Tcl_SetVar2(interp,name1,name2,charbuf,flags&TCL_GLOBAL_ONLY);
  55.         ckfree(charbuf);
  56.     } else {
  57.         /* Read a simple char : */
  58.         static char res[2]={0,0};
  59.         res[0] = *((char *)object->data);
  60.         if ( (res[0] == '\0') &&
  61.          !(object->type->flags & STRUCT_FLAG_NULL_OK) )
  62.         return "nul character";
  63.         Tcl_SetVar2(interp,name1,name2,res,flags&TCL_GLOBAL_ONLY);
  64.     }
  65.     } else if (flags & TCL_TRACE_WRITES) {
  66.     if (object->type->flags & STRUCT_FLAG_IS_ARRAY) {
  67.         /* Write an array of chars */
  68.         char *s;
  69.         int len;
  70.         if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  71.         return "null ptr in char write";
  72.         if ( ((len = strlen(s)) > object->size) &&
  73.          (object->type->flags & STRUCT_FLAG_STRICT) )
  74.         return "char string too long";
  75.         else if (len >= object->size ) {
  76.         memcpy( (char *)object->data, s, object->size );
  77. #ifdef DEBUG
  78.         if (struct_debug & (DBG_CHAR))
  79.         printf("Struct_TraceChar: Write char*%d %s with {%s}\n",
  80.             object->size, Struct_ObjectName(object,0), s );
  81. #endif
  82.         } else if ( (len == 0) && (object->type->flags & STRUCT_FLAG_NULL_OK) ) {
  83.         /* If nullok, then write binary zeroes irrespective of fill */
  84.         memset( (char *)object->data, 0x00, object->size );
  85.         } else {
  86.         memcpy( (char *)object->data, s, len );
  87.         memset( (char *)object->data + len,
  88.             (object->type->fill != NULL) ? *object->type->fill : '\0',
  89.             object->size - len );
  90. #ifdef DEBUG
  91.         if (struct_debug & (DBG_CHAR)) {
  92.           printf("Struct_TraceChar: Write char*%d %s with {%s}",
  93.             object->size, Struct_ObjectName(object,0), s );
  94.           if (object->type->fill != NULL)
  95.             printf(", fill = {%s}", object->type->fill );
  96.           printf("\n");
  97.         }
  98. #endif
  99.         }
  100.     } else {
  101.         /* Write a single char : */
  102.         char *s;
  103.         if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  104.         return "null ptr in char write";
  105.         if ( (*s == '\0') &&
  106.          !(object->type->flags & STRUCT_FLAG_NULL_OK) )
  107.         return "nul character";
  108.         if ( ((int)strlen(s) > 1) &&    /* len==0 --> nul char */
  109.          (object->type->flags & STRUCT_FLAG_STRICT) )
  110.         return "bad char";
  111.         *((char*)object->data) = *s;    /* len==0 --> nul char */
  112.     }
  113.     } else {
  114.     /* Unset : */
  115. #ifdef DEBUG
  116.     printf("\tunset!\n");
  117. #endif
  118.     Struct_DeleteObject(object);
  119.     }
  120.     return NULL;    
  121. }
  122.  
  123.  
  124. /* I/O Hex Trace */
  125. char *
  126. Struct_TraceHex(cdata, interp,name1,name2,flags)
  127.   ClientData cdata;
  128.   Tcl_Interp *interp;
  129.   char *name1,*name2;
  130.   int flags;
  131. {
  132.     Struct_Object *object = (Struct_Object *)cdata;
  133.     static char hexchar[] = "0123456789abcdef";
  134.  
  135.     if (flags & TCL_TRACE_READS) {
  136.     /* Read the object as a Hexadecimal string */
  137.     char *hexbuf;
  138.     char *p;
  139.     unsigned char *s;
  140.     int n;
  141.     if ((hexbuf = ckalloc( 2 * object->size + 1 )) == NULL)
  142.         return "can't allocate memory for hex result";
  143.     for ( p = hexbuf, s = object->data, n = object->size; --n >= 0;) {
  144.         *p++ = hexchar[*s >> 4];
  145.         *p++ = hexchar[*s++ & 0x0f];
  146.     }
  147.     *p = '\0';
  148.     Tcl_SetVar2(interp,name1,name2,hexbuf,flags&TCL_GLOBAL_ONLY);
  149.     ckfree(hexbuf);
  150.     } else if (flags & TCL_TRACE_WRITES) {
  151.     /* Write the object as a Hexadecimal string */
  152.     char *s;
  153.     char *p;
  154.     char *i1, *i2;
  155.     int n;
  156.     if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  157.         return "null ptr in hex write";
  158.     if ((n = strlen(s)) & 01)
  159.         return "hex string has odd number of bytes";
  160.     if ((n >>= 1) != object->size) {
  161.         if (object->type->flags & STRUCT_FLAG_STRICT)
  162.         return "incorrect hex string length";
  163.         if (n < object->size)
  164.         memset( (char *)object->data + n, 0x00, object->size - n );
  165.         else
  166.         n = object->size;
  167.     }
  168.     for ( p = object->data; --n >= 0; ) {
  169.         if ( ((i1 = strchr(hexchar,*s++)) == NULL) ||
  170.              ((i2 = strchr(hexchar,*s++)) == NULL) )
  171.             return "not a valid hex string";
  172.         *p++ = ((i1 - hexchar) << 4) + (i2 - hexchar);
  173.     }
  174.     } else {
  175.     /* Unset : */
  176. #ifdef DEBUG
  177.     printf("\tunset!\n");
  178. #endif
  179.     Struct_DeleteObject(object);
  180.     }
  181.     return NULL;    
  182. }
  183.  
  184.  
  185. /* I/O String Trace */
  186. char *
  187. Struct_TraceString(cdata, interp,name1,name2,flags)
  188.   ClientData cdata;
  189.   Tcl_Interp *interp;
  190.   char *name1,*name2;
  191.   int flags;
  192. {
  193.     Struct_Object *object = (Struct_Object *)cdata;
  194.     
  195.     if (flags & TCL_TRACE_READS) {
  196.     /* Read a string : */
  197.     char *s;
  198.     /* If the string has a NULL pointer, then either return an
  199.      * error or an empty string.
  200.      */
  201.     if ((s = *(char **)object->data) != NULL)
  202.         Tcl_SetVar2(interp,name1,name2,s,flags&TCL_GLOBAL_ONLY);
  203.     else if ( !(object->type->flags & STRUCT_FLAG_NULL_OK) &&
  204.               (object->type->flags & STRUCT_FLAG_STRICT) )
  205.         return "trying to dereference NULL pointer";
  206.     else
  207.         Tcl_SetVar2(interp,name1,name2,"",flags&TCL_GLOBAL_ONLY);
  208.     } else if (flags & TCL_TRACE_WRITES) {
  209.     /* Write a string : */
  210.     char *s, *p;
  211.     if ((s = Tcl_GetVar2(interp,name1,name2,flags&TCL_GLOBAL_ONLY)) == NULL)
  212.         return "null ptr in string write";
  213.     /*  Free the old string.  */
  214.     if ((p = *(char **)object->data) != NULL)
  215.         ckfree(p);
  216.  
  217.     /*  If the user is writing the empty string and NULL_OK
  218.      *  is set, then set the string pointer to NULL rather
  219.      *  than having it point to an empty string.
  220.      */
  221.     if ( (*s == '\0') &&
  222.          (object->type->flags & STRUCT_FLAG_NULL_OK) ) {
  223.         *(char **)object->data = NULL;
  224.     } else {
  225.         int n = strlen(s) + 1;
  226.         if ((p = *(char **)object->data = ckalloc(n)) == NULL)
  227.         return "failed malloc in string write";
  228.         memcpy( p, s, n );
  229.     }
  230.     } else {
  231.     /* Unset : */
  232. #ifdef DEBUG
  233.     printf("\tunset!\n");
  234. #endif
  235.     Struct_DeleteObject(object);
  236.     }
  237.     return NULL;    
  238. }
  239.  
  240.